home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tk_bar / tkbar.bas < prev    next >
BASIC Source File  |  1993-12-06  |  20KB  |  655 lines
  1. Option Explicit
  2.  
  3. Const MAXITEMS = 30       'max valid program items
  4. Const MAXITEMPTRS = 50    'max program item file pointers
  5.  
  6. Type POINTAPI
  7.    x As Integer
  8.    y As Integer
  9. End Type
  10.  
  11. Type RECT
  12.    Left As Integer
  13.    Top As Integer
  14.    right As Integer
  15.    bottom As Integer
  16. End Type
  17.  
  18.  
  19. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal w%, ByVal h%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  20. Declare Function CreateBitmap% Lib "GDI" (ByVal w%, ByVal h%, ByVal Planes%, ByVal BitCnt%, ByVal Bits As Any)
  21. Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
  22. Declare Function CreateDC% Lib "GDI" (ByVal Driver$, ByVal DeviceName$, ByVal lpOutput$, ByVal InitData$)
  23. Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
  24. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  25. Declare Function GetPrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpDefault$, ByVal ReturnString$, ByVal nSize%, ByVal Filename$)
  26. Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
  27. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  28. Declare Function RestoreDC% Lib "GDI" (ByVal hDC%, ByVal SavedDC%)
  29. Declare Function SaveDC% Lib "GDI" (ByVal hDC%)
  30. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  31. Declare Function SetBitmapBitsByString& Lib "GDI" Alias "SetBitmapBits" (ByVal hBmp%, ByVal Count&, ByVal lpBits$)
  32. Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  33. Declare Function ShellExecute% Lib "shell.dll" (ByVal hWnd%, ByVal Op$, ByVal File$, ByVal Parms$, ByVal RunDir$, ByVal ShowCmd%)
  34. Declare Function WritePrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpString$, ByVal Filename$)
  35.  
  36. 'BitBlt constants
  37. Global Const SRCCOPY = &HCC0020
  38. Global Const SRCAND = &H8800C6
  39. Global Const SRCINVERT = &H660046
  40.  
  41. ' SetWindowPos Flags
  42. Global Const HWND_TOPMOST = -1
  43. Global Const HWND_NOTOPMOST = -2
  44. Global Const SWP_NOSIZE = &H1
  45. Global Const SWP_NOMOVE = &H2
  46.  
  47. ' GetSystemMetric item
  48. Global Const SM_CYCAPTION = 4
  49.  
  50. ' MsgBox parameters
  51. Global Const MB_OK = 0                 ' OK button only
  52. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  53. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  54. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  55. Global Const MB_YESNO = 4              ' Yes and No buttons
  56. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  57. Global Const MB_ICONSTOP = 16          ' Critical message
  58. Global Const MB_ICONQUESTION = 32      ' Warning query
  59. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  60. Global Const MB_ICONINFORMATION = 64   ' Information message
  61. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  62. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  63. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  64. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  65. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  66.  
  67. ' ShowWindow() and ShellExecute() commands
  68. Global Const SW_HIDE = 0
  69. Global Const SW_SHOWNORMAL = 1
  70. Global Const SW_NORMAL = 1
  71. Global Const SW_SHOWMINIMIZED = 2
  72. Global Const SW_SHOWMAXIMIZED = 3
  73. Global Const SW_MAXIMIZE = 3
  74. Global Const SW_SHOWNOACTIVATE = 4
  75. Global Const SW_SHOW = 5
  76. Global Const SW_MINIMIZE = 6
  77. Global Const SW_SHOWMINNOACTIVE = 7
  78. Global Const SW_SHOWNA = 8
  79. Global Const SW_RESTORE = 9
  80.  
  81. Type GroupHeaderType
  82.   Id As String * 4
  83.   CheckSum As Integer
  84.   OffsetTag As Integer
  85.   CmdShow As Integer
  86.   Normal As RECT
  87.   Min As POINTAPI
  88.   OffsetName As Integer
  89.   LogPixelsx As Integer
  90.   LogPixelsy As Integer
  91.   BitsPerPixel As String * 1
  92.   Planes As String * 1
  93.   Reserved As Integer
  94.   NumItems As Integer
  95. End Type
  96.  
  97. Type GroupItemType
  98.   pt As POINTAPI             'coords of item in grp window
  99.   IconIndex As Integer
  100.   ResourceBytes As Integer
  101.   ANDPlaneBytes As Integer
  102.   XORPlaneBytes As Integer
  103.   OffsetResource As Integer
  104.   OffsetANDPlane As Integer
  105.   OffsetXORPlane As Integer
  106.   OffsetName As Integer
  107.   OffsetExeName As Integer
  108.   OffsetIconPath As Integer
  109. End Type
  110.  
  111. Type TagDataType
  112.   Id As Integer
  113.   Item As Integer
  114.   NextPtr As Integer
  115.   Dunno As String * 1
  116. End Type
  117.  
  118. Type MyItemInfoType        'to store the stuff after parsing
  119.   ExeName As String * 80
  120.   WorkingDir As String * 80
  121.   Arguments As String * 80
  122. End Type
  123. '
  124. '  Vars prefixed with 's' are shared to one module or form
  125. '  Vars prefixed with 'g' are global
  126. '
  127. Dim Shared sHdr As GroupHeaderType
  128. Dim Shared sItems(MAXITEMS) As GroupItemType
  129. Dim Shared sMyItemInfo(MAXITEMS) As MyItemInfoType
  130. Dim Shared sItemPtr(MAXITEMPTRS)  As Integer
  131. Dim Shared sCommandPath(MAXITEMS) As String
  132. Dim Shared sCaptionHeight As Integer      'height of window title bar
  133. Dim Shared sLastLoaded As Integer         'for button ctrl array mgmnt
  134.  
  135. Global gActualItemCt As Integer           'valid program item count
  136. Global gGroupFilename As String
  137. Global gWindowsDir As String
  138. Global gGridRows As Integer               'for bar config
  139. Global gGridCols As Integer               'for bar config
  140. Global gOnTop As Integer                  'for bar config
  141.  
  142. Sub ButtonBarDraw ()
  143. '
  144. '  Configure the button bar window based on
  145. '  gGridRows, gGridCols, gOnTop, and gActualItemCt
  146. '
  147. Dim i%
  148. Dim flags%, TopPos%, LeftPos%
  149. Dim CurrRow%, CurrCol%, CurrItem%
  150.  
  151.   'pixels are the only way to go
  152.   frmButtonBar.ScaleMode = 3
  153.  
  154.   For CurrRow = 1 To gGridRows
  155.      '
  156.      '  czech if last row was enough for all the items
  157.      '
  158.      If ((CurrRow - 1) * gGridCols) >= gActualItemCt Then
  159.         gGridRows = CurrRow - 1
  160.         Exit For
  161.      End If
  162.      TopPos = (CurrRow - 1) * (frmButtonBar!cmdIcon(0).Height + 1)
  163.      For CurrCol = 1 To gGridCols
  164.         CurrItem = ((CurrRow - 1) * gGridCols + CurrCol) - 1
  165.         '
  166.         '  munch all you want.  we'll make more!
  167.         '
  168.         If CurrItem > sLastLoaded Then
  169.            Load frmButtonBar!cmdIcon(CurrItem)
  170.            sLastLoaded = sLastLoaded + 1
  171.         End If
  172.         '
  173.         '  disable blank buttons
  174.         '
  175.         If CurrItem > (gActualItemCt - 1) Then
  176.            frmButtonBar!cmdIcon(CurrItem).Picture = LoadPicture("")
  177.            frmButtonBar!cmdIcon(CurrItem).Visible = True
  178.            frmButtonBar!cmdIcon(CurrItem).Enabled = False
  179.         End If
  180.         frmButtonBar!cmdIcon(CurrItem).Top = TopPos
  181.         LeftPos = (CurrCol - 1) * (frmButtonBar!cmdIcon(0).Width + 1)
  182.         frmButtonBar!cmdIcon(CurrItem).Left = LeftPos
  183.      Next
  184.   Next
  185.   '
  186.   '  unload any extra controls from previous config
  187.   '
  188.   Do While (sLastLoaded + 1) > (gGridRows * gGridCols)
  189.      Unload frmButtonBar!cmdIcon(sLastLoaded)
  190.      sLastLoaded = sLastLoaded - 1
  191.   Loop
  192.  
  193.   frmButtonBar.Width = ((gGridCols * (frmButtonBar!cmdIcon(0).Width + 1)) + 1) * screen.TwipsPerPixelX
  194.   frmButtonBar.Height = ((gGridRows * (frmButtonBar!cmdIcon(0).Height + 1)) + sCaptionHeight) * screen.TwipsPerPixelY
  195.  
  196.   frmButtonBar.Refresh
  197.  
  198.   If gOnTop Then
  199.      flags = SWP_NOMOVE Or SWP_NOSIZE
  200.      Call SetWindowPos(frmButtonBar.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  201.   Else
  202.      flags = SWP_NOMOVE Or SWP_NOSIZE
  203.      Call SetWindowPos(frmButtonBar.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)
  204.   End If
  205.  
  206.   'Debug.Print sLastLoaded
  207. End Sub
  208.  
  209. Sub ButtonBarExecute (ByVal ItemNum)
  210. '
  211. '  execute the corresponding program for the button ItemNum
  212. '
  213. Dim temp%, RunDir$, ExeName$, Args$, Msg$
  214.  
  215.   ExeName$ = RTrim$(sMyItemInfo(ItemNum).ExeName)
  216.   RunDir$ = RTrim$(sMyItemInfo(ItemNum).WorkingDir)
  217.   Args$ = RTrim$(sMyItemInfo(ItemNum).Arguments)
  218.  
  219.   temp = ShellExecute(frmButtonBar.hWnd, "Open", ExeName$, Args$, RunDir$, SW_SHOWNORMAL)
  220.  
  221.   If temp < 32 Then
  222.     Select Case temp
  223.     Case 0:   Msg$ = "Insufficient system memory or corrupt program file."
  224.     Case 2:   Msg$ = "File not found."
  225.     Case 3:   Msg$ = "Invalid